perm filename FINDER.FAI[HAK,HPM]3 blob
sn#250949 filedate 1976-12-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE FINDER
C00006 00003 SUBTTL DATA STORAGE
C00011 00004 SUBTTL ALARUMS AND DIVERSIONS
C00013 00005 SUBTTL VARIOUS FLAVORS OF OUTPUT STUFF
C00021 00006 USRMOD: PJOB 2,
C00023 00007 SUBTTL FIND
C00025 00008 SUBTTL THINK ABOUT PRIVILEGES
C00031 00009 SUBTTL LIST USER DATUM.
C00035 00010 SUBTTL MODIFY A USER'S INFO ENTRY
C00039 00011 SUBTTL READ UFD
C00040 00012 SUBTTL DREAD READ A WHOLE FILE IN DUMP MODE.
C00043 00013 SUBTTL INITIALIZE
C00046 00014 SUBTTL DO-ALL SCANNER. MAXIMUM UTILITY AND INTOLERANCE.
C00051 ENDMK
C⊗;
TITLE FINDER
EXTERN JOBFF,JOBREL,JOBDDT
;ASSEMBLY FLAGS
PTYBIT←←4000 ;LINE CHAR. PTY LINE
IMPBIT←←1000 ;THIS AND PTYBIT MEANS THIS IS AN IMP
JLOG←←10000 ;JOB IS LOGGED IN. BIT IN JBTSTS
PDLEN←←20 ;SIZE OF PUSH-DOWN LIST
UFDN←←4 ;LENGTH OF UFD ENTRY
MFDTRK←←1 ;TRACK WHERE MFD IS FOUND
INFON←←5 ;LENGTH OF INFO DATA AREA
INFBAS←←13 ;LOCATION OF INFO DATA IN RETRIEVAL
PTYJOB←←270 ;CELL TO PEEK IN TO FIND PTYJOB
TTYNUM←←221 ;CELL TO GET DATA ABOUT THE NUMBER OF TELETYPES.
PRJPRG←←211 ;POINTER TO PRJPRG IN SYSTEM
; INDICIES TO INFON
LOSPSW←←0 ;PASSWORD INDEX
PRVBIT←←1 ;USER'S PRIV. BITS
LASDAT←←2 ;LAST DATE WHEN HE WAS LOGGED IN
DEFPRO←←3 ;DEFAULT PROTECTION
DSK←←17 ;READ/WRITE CHANNEL FOR DSK.
DMP←←16 ;DISK FOR DUMP MODE
TTY←←15
DPYBIT←←400000 ;III BIT IN GETLIN
CTYBIT←←200000 ;CTY
DDBIT←←20000 ;DD BIT IN GETLIN
CTLVF←←40 ;FLAG TO REMEMBER CTLV MODE
PTYLIN←←200 ;SET IF PTY
CTYLIN←←400 ;SET IF CTY LOGIN
DPYLIN←←1000 ;SET IF EITHER III OR DD DISPLAY
NEGF←←10000 ;SET TO FLUSH A PRIVILEGE
NODATE←←20000 ;SET TO PREVENT LASDAT UPDATE
NOTNOW←←40000 ;SET IF NOLOGIN IN SYSTEM ≠ 0
IMPLIN←←100000 ;SET IF THIS IS AN IMP
;PRIVILEGE BITS
INFPRV←←20 ;ACCESS TO INFO DATA IN UFD
PROPRV←←100000 ;RENAME THRU FILE SYSTEM IS OK
REAPRV←←40000 ;READ THRU FILE SYSTEM IS OK
WRTPRV←←20000 ;WRITE THRU FILE SYSTEM IS OK
DAWPRV←←200000 ;DISK ABSOLUTE WRITE PRIVILIGE
LUPPRV←←1
LOGPRV←←DAWPRV!INFPRV!PROPRV!REAPRV!WRTPRV!LUPPRV ;PRIVILEGES FOR LOGIN
FL←0 ↔ A←1 ↔ B←2 ↔ C←3 ↔ D←4 ↔ W←5 ↔ X←6 ↔ Y←7 ↔ Z←10 ↔ K←11
L←12 ↔ M←13 ↔ N←14 ↔ TAC←15 ↔ TAC1←16 ↔ P←17
LOC 137
13 ;JOBVERSION
RELOC 0
SUBTTL DATA STORAGE
LPBITS: XWD 400000,'PRI' ;PRIVILEGE PRIVILEGE
XWD 200000,'DAW' ;DISK ABSOLUTE WRITE
XWD 100000,'PRO' ;FILE SYSTEM RENAME
XWD 40000,'REA' ;FILE SYSTEM READ
XWD 20000,'WRT' ;FILE SYSTEM WRITE
XWD 10000,'UDP' ;UDP EXTENDED ACCESS
XWD 4000,'UPG' ;SELECT OTHER III'S
XWD 2000,'MES' ;TTYMES UUO
XWD 1000,'KIL' ;CONSOLE KILL COMMAND
XWD 400,'DEV' ;DET/ATT DEVICE
XWD 200,'SEG' ;SEGMENT ACCESS PRIV
XWD 100,'SSL' ;SET SYSTEM SERVICE LEVEL TABLE
XWD 40,'ACW' ;ABSOLUTE CORE WRITE (SETPR2)
XWD 20,'INF' ;DISK ABSOLUTE READ
XWD 10,'TLK' ;CAN DO TALKS
XWD 4,'FBW' ;FAST BAND WRITE OR WRONG
XWD 2,'XGP' ;XGP FONT ACCESS.
XWD 1,'LUP' ;The Not Telnet Privilege
LPBLL←←.-LPBITS
RPBITS: ;RIGHT SIDE BITS.
RPBLL←←.-RPBITS
ALLPRV: 777775,,0 ;THESE ARE THE LEGAL ONES FOR USERS
;NOTE: XGPPRV ISN'T ALLOWED.
GOD: ' 1 1'
CRLF: BYTE(7)15,12
MONTHT: SIXBIT/JAN/
SIXBIT/FEB/
SIXBIT/MAR/
SIXBIT/APR/
SIXBIT/MAY/
SIXBIT/JUN/
SIXBIT/JUL/
SIXBIT/AUG/
SIXBIT/SEP/
SIXBIT/OCT/
SIXBIT/NOV/
SIXBIT/DEC/
MONTLG←←.-MONTHT ;LENGTH OF MONTH TABLE
FILBLK←←2 ;NUMBER OF BLOCKS OF THE FILE TO READ
;WARNING!!! FILBLK MUST BE AT LEAST 2.
FILENG←←FILBLK*200 ;NUMBER OF WORDS TO READ
INRD: 'GODMOD' ;FOR MTAPE TO READ INFO AREA
1 ;READ
IOWD 40,FILE0 ;IOWD FOR TRANSFER
INRD1: 0 ;XWD RECORD,TRACK NUMBER
RDINFO: 'GODMOD' ;READ RETRIEVAL INFO
10
INFOS
WRINFO: 'GODMOD' ;WRITE RETRIEVAL INFO
11
INFOS
DEBUG: 0
DSKBUF: BLOCK 3 ;BUFFER HEADER
TTYOBF: BLOCK 3 ;BUFFER HEADER FOR CHANNEL "TTY"
TTYBUF: 0 ;ADDRESS OF BUFFERS FOR USER CONSOLE
DISKBF: 0 ;PLACE TO PUT DISK BUFFERS
NOW: 0 ;SET TO DATE,,TIME IN MINUTES WHEN STARTED
DBLOCK:
USER: 0 ;USERS PPN
USRBIT: 0 ;USER PRIVILEGE BITS
LBLEN←←.-DBLOCK
UFDLOK: BLOCK 5 ;4 WORDS FOR UFD RENAME BLOCK, 5TH FOR FLAG
PDLIST: BLOCK PDLEN ;PUSH DOWN LIST
GOTUFD: 0 ;HAS USER ALREADY GOT A UFD?
INFOS: BLOCK INFON
PHRASE: BLOCK 2 ;PROJECT/WD 1, PROGRAMMER/WD 2.
MFDPT: 0
LPTBUF: 0
BUF: ;THIS IS A PUN. USED FOR READING LOG.LOG
FILE0: BLOCK 40 ;BLOCK FOR THE RETRIEVAL
FILE: BLOCK FILENG ;BLOCK FOR FIRST BLOCK OF FILE
MUDPTR: BLOCK 2
YEAR: 0
TIME: 0
FILLCH: 0
BASECH: 0
RAD: TZAP: 0 ;RADIX FOR ALLRAD PRINTER.
; TZAP IS LAST WORD ZEROED BY BLT AT START
LASLOG: 0
DAYTAB: ASCIZ /Sunday/
ASCIZ /Monday/
ASCIZ /Tuesday/
ASCIZ /Wednesday/
ASCIZ /Thursday/
ASCIZ /Friday/
ASCIZ /Saturday/
CKCODE: -1 ;SET TO ZERO IF LOSER IS NOT AUTHORIZED.
PATCH: BLOCK 20
PATCH1: BLOCK 20
PATCH2: BLOCK 20
JOBQUE: 0
JBTSTS: 0
JOBN: 0
SVSTAT: 0
LINCHR: 0 ;TTY LINE CHARACTERISTICS WORD
PTYTJB: 0 ;JOB NUMBER OF CONTROLLER IF THIS IS A PTY.
PTYPPN: 0 ;PPN OF CONTROLLING JOB FOR PTY LINES.
CHTEMP: 0
TYIBUF: BLOCK 50 ;BUFFER FOR SPECIAL HACK MODE
SUBTTL ALARUMS AND DIVERSIONS
NODISK: OUTSTR [ASCIZ /CAN'T INIT THE DISK
/]
EXIT
NOCORE: OUTSTR [ASCIZ/Core uuo failed!
/]
EXIT
UFDEER: OUTSTR [ASCIZ/Can't make your new ufd
/]
EXIT
UFDLER: OUTSTR [ASCIZ/UFD Lookup failed. /]
CAIL B,UERRTL
MOVEI B,0 ;LOSER LOSER
OUTSTR @UERRTB(B) ;GIVE MESSAGE FROM TABLE
OUTSTR CRLF
EXIT
UERRTB: [ASCIZ/UNKNOWN STATUS/]
[ASCIZ/ILLEGAL PPN/]
[ASCIZ/PROTECTION/]
[ASCIZ/RENAME ERROR/]
[ASCIZ/RENAME ERROR/]
[ASCIZ/RENAME ERROR/]
[ASCIZ/NAMES CONFLICT/]
[ASCIZ/NO INIT/]
[ASCIZ/BAD MFD ENTRY/]
[ASCIZ/UFD GARBAGED/]
UERRTL←←.-UERRTB
NOUFD: OUTSTR [ASCIZ/I CAN'T FIND THE UFD THAT I JUST MADE FOR YOU!
/]
EXIT
SUBTTL VARIOUS FLAVORS OF OUTPUT STUFF
; OUTPUT ROUTINES. ALL ROUTINES USE PUTCHR TO TYPE
; ONE CHARACTER ON CHANNEL TTY. THIS CHANNEL IS INITIALLY
; THE USER CONSOLE, BUT MAY BE SWITCHED TO THE LPT
; FOR THE L COMMAND FROM [1,2] USER MODE.
LPTRLS: SKIPN A,LPTBUF ;ASSUME LPT BUFFER IS AT HIGH CORE
POPJ P, ;NO BUFFERS-NO RELEASE
MOVEM A,JOBFF ;RECLAIM THE SPACE
CLOSE TTY, ;FORCE OUT ALL THE DATA
SETZM LPTBUF ;ZERO THE BUFFER POINTER
TTYINI: INIT TTY,0 ;GET THE TTY
'TTY ' ;USER CONSOLE
XWD TTYOBF,0 ;OUTPUT ONLY
HALT ;THIS CAN'T HAPPEN
SKIPN A,TTYBUF ;DID WE HAVE BUFFERS ONCE BEFORE?
JRST TTYIN1 ;NOPE. MAKE NEW ONES
EXCH A,JOBFF ;YES RESET JOBFF
OUTBUF TTY,2 ;RESET THE OLD BUFFERS
MOVEM A,JOBFF ;RESTORE JOBFF
POPJ P, ;ALL DONE
TTYIN1: MOVE A,JOBFF ;GET JOBFF
MOVEM A,TTYBUF
OUTBUF TTY,2 ;GET SOME BUFFERS
POPJ P, ;RETURN
LPTINI: INIT TTY,0 ;GET THE LPT ON CHANNEL NAMED TTY
'LPT '
XWD TTYOBF,0
JRST LPTIN1 ;NO LPT AVAILABLE
MOVE A,JOBFF ;GET THE PRESENT JOBFF
MOVEM A,LPTBUF ;SAVE AS ADDRESS OF THE LPT BUFFER
OUTBUF TTY,2 ;GET SOME BUFFERS
JRST CPOPJ1 ;SKIP RETURN
LPTIN1: OUTSTR [ASCIZ/LPT IS NOT AVAILABLE.
/]
POPJ P, ;RETURN
PUTCHR: SKIPN LPTBUF ;ONLY DO IT THE HARD WAY FOR LPT
JRST PUTCH2
SOSG TTYOBF+2 ;DECREMENT CHARACTER COUNT
OUTPUT TTY, ;WRITE A BUFFER
IDPB A,TTYOBF+1 ;DEPOSIT CHARACTER IN BUFFER
POPJ P,
PUTCH2: TTCALL 1,A ;WRITE ONE CHARACTER
POPJ P,
PUTSTR: HRLI B,440700 ;7 BIT BYTE POINTER IN B
PUTST1: ILDB A,B ;LOAD A BYTE
JUMPE A,CPOPJ ;RETURN IF NULL
PUSHJ P,PUTCHR ;WRITE CHARACTER
JRST PUTST1 ;LOOP
DECOUT: SKIPA B,[12] ;THE BASE
OCTOUT: MOVEI B,10 ;BASE FOR OCTAL
MOVEM B,RAD
SETZ TAC,
MOVEI B,"0"
MOVEM B,BASECH ;SAVE BASE CHARACTER
ALLRAD: IDIV A,RAD ;DIVIDE BY THE RADIX
HRLM B,(P) ;SAVE REMAINDER
SUBI TAC,1 ;DECREMENT THE CHARACTER COUNT
JUMPE A,ALLRD1 ;JUMP IF DEEP ENOUGH
PUSHJ P,ALLRAD ;NO. MAKE A RECURSIVE CALL
JRST ALLRD3 ;BUBBLE UP FROM RECURSION
ALLRD1: MOVE A,FILLCH ;GET THE FILL CHARACTER
ALLRD2: SOJL TAC,ALLRD3 ;ALL DONE WITH FILL?
PUSHJ P,PUTCHR ;NO. WRITE ONE CHARACTER
JRST ALLRD2 ;LOOP
ALLRD3: HLRZ A,(P)
ADD A,BASECH ;ADD THE BASE CHARACTER
JRST PUTCHR ;WRITE A CHARACTER AND POPJ.
TWODIG: MOVEI B,12
MOVEM B,RAD
MOVEI TAC,2
MOVEI B,"0"
MOVEM B,FILLCH
MOVEM B,BASECH
JRST ALLRAD
SIXOUT: MOVE TAC1,A ;GET THE SIXBIT INTO TAC1
SIXOU1: JUMPE TAC1,CPOPJ ;RETURN IF ALL DONE
SETZ TAC, ;ZERO IN TAC
LSHC TAC,6 ;MOVE CH. INTO TAC
MOVEI A," "(TAC) ;MAKE CHARACTER IN A
PUSHJ P,PUTCHR
JRST SIXOU1 ;LOOP
TYFIL: PUSHJ P,SIXOUT ;TYPE FILE NAME FROM A
HLLZ B,B ;GET THE EXTENSION
JUMPE B,CPOPJ ;NO EXTENSION
MOVEI A,"."
PUSHJ P,PUTCHR
MOVE A,B
JRST SIXOUT ;WRITE MORE
TYPPN: HRLZ B,A ;GET THE PROG
PUSH P,B ;SAVE
HLLZ B,A ;GET THE PROJ
MOVEI A,"["
PUSHJ P,PUTCHR
MOVE A,B
PUSHJ P,SIXOUT
MOVEI A,","
PUSHJ P,PUTCHR
POP P,A
PUSHJ P,SIXOUT
MOVEI A,"]"
JRST PUTCHR
TDOUT: JUMPE A,TDOUTX ;JUMP IF NO ENTRY HERE
HLRZ B,A ;GET THE DATE
HRRZ A,A ;GET THE TIME
PUSH P,A ;SAVE TIME
IDIVI B,37 ;GET THE DAY IN C
MOVEI A,1(C) ;SAVE DAY OF MONTH
IDIVI B,14 ;GET MONTH IN C
ADDI B,100
MOVEM B,YEAR ;SAVE YEAR
PUSHJ P,DECOUT ;WRITE DECIMAL
MOVEI A,"-" ;WRITE -
PUSHJ P,PUTCHR
MOVE A,MONTHT(C) ;GET THE NAME OF MONTH
PUSHJ P,SIXOUT
MOVEI A,"-"
PUSHJ P,PUTCHR
MOVE A,YEAR
PUSHJ P,DECOUT
MOVEI A,11
PUSHJ P,PUTCHR
POP P,A
IDIVI A,74 ;HOURS IN A,MINUTES IN B
PUSH P,B
PUSHJ P,TWODIG
POP P,A
JRST TWODIG ;WRITE TWO MORE AND RETURN
TDOUTX: MOVEI A,11 ;GET A TAB
PUSHJ P,PUTCHR ;WRITE ONE
JRST PUTCHR ;WRITE TWO
LOGON: TRNE FL,PTYLIN
POPJ P, ;NOTHING FOR PTY'S
HLRZ A,NOW ;GET THE CURRENT DATE
IDIVI A,37
MOVEI D,1(B) ;GET DAY OF MONTH IN D
IDIVI A,14 ;YEAR IN A, MONTH IN B
TRNN A,3 ;SKIP IF NOT LEAP YEAR
CAIGE B,2 ;SKIP IF AFTER FEBRUARY ON LEAP YEAR
SUBI D,1 ;NOT LEAP YEAR & PAST FEB. SUBTRACT 1
ADDI A,3 ;JAN 1, 1964 WAS A WEDNESDAY
ADD D,A
LSH A,-2 ;DIV BY 4 MAKE # OF LEAP YEARS SINCE JAN 64
ADD A,D ;BASE FOR THIS DAY AND YEAR
MOVE D,[033614625035];MONTH OFFSET WORD
ROT D,1(B)
ROT D,1(B)
ROT D,1(B)
ANDI D,7
ADD A,D
IDIVI A,7
LSH B,1 ;DOUBLE THE INDEX VALUE
OUTSTR DAYTAB(B)
OUTSTR [ASCIZ/ /] ;TYPE A TAB
MOVE A,NOW
PUSHJ P,TDOUT ;TYPE IT
MOVEI B,CRLF
PUSHJ P,PUTSTR
CLOSE TTY, ;FORCE IT OUT
POPJ P, ;RETURN
OCTIN0: OUTSTR [ASCIZ/ILLEGAL CHARACTER IN OCTAL SCAN. PLEASE TRY AGAIN
/]
OCTIN: SETZB A,C ;CLEAR SUCCESS FLAG, ACCUMULATOR
OCTIN1: INCHWL B
CAIN B,15
JRST OCTIN1
CAIN B,12
POPJ P, ;C>0 IF ANYTHING SEEN
JUMPL C,OCTIN0 ;ONLY CRLF ALLOWED AFTER ?
JUMPG C,OCTIN2 ;? NOT ALLOWED AFTER DIGIT
CAIN B,"?"
SOJA C,OCTIN1 ;C<0 FOR HELP REQUEST
OCTIN2: CAIL B,"0"
CAILE B,"7"
JRST OCTIN0 ;ERROR
LSH A,3
ADDI A,-"0"(B)
AOJA C,OCTIN1 ;LOOP
USRMOD: PJOB 2,
MOVEI 1,271
PEEK 1,
ADD 1,2
PEEK 1,
JUMPL 1,GOO
EXIT
GOO: MOVE 1,[777777,,0]
SETPRV 1,
SETZM LPTBUF
PUSHJ P,TTYINI
UCON: PUSHJ P,RMFD ;READ THE MFD
UCMSG: OUTSTR [ASCIZ/
E EXIT
M MODIFY
F FIND USERS
P PRIVILEGE NAMES
/]
SKIPE JOBDDT
OUTSTR [ASCIZ/$ DDT
/]
UC: OUTSTR [ASCIZ/*/]
INCHWL A
CLRBFI
CAIL A,"a"
CAILE A,"z"
JRST .+2
TRZ A,40
MOVSI B,-UCTL
HLRZ C,UCT(B)
CAME A,C
AOBJN B,.-2
JUMPL B,UC1
OUTSTR [ASCIZ/?
/]
JRST UC
UC1: HRRZ C,UCT(B)
PUSHJ P,(C)
JRST UC
UCT: XWD "E",UEXIT
XWD 12,CPOPJ
XWD 15,CPOPJ
XWD ">",FIND
XWD "∃",MODIFY
XWD "$",DDTGO
XWD 175,DDTGO
XWD "H",UCTYPE
XWD "P",PTYPE ;TYPE PRIVILEGE NAMES
XWD "&",ITYPE ;TYPE STUFF
XWD "↔",ILIST ;LIST STUFF
UCTL←←.-UCT
DDTGO: SKIPN JOBDDT
JRST NODDT
OUTSTR [ASCIZ/(DDT)
/]
JRST @JOBDDT
UCTYPE: POP P,(P)
JRST UCMSG
NODDT: OUTSTR [ASCIZ/NO DDT
/]
POPJ P,
UEXIT: EXIT 1,
SUBTTL FIND
FIND: OUTSTR [ASCIZ/USER = /]
PUSHJ P,SIXIN ;GET SOME SIXBIT
HRRZM B,PHRASE ;SAVE PART 1
CAIN A,"," ;MUST SEE A COMMA
JRST FIND0 ;COMMA
CAIE A,12 ;NOT COMMA: NEED LF
JRST FNDERR ;I DON'T UNDERSTAND
JRST FIND0A ;OK, B WILL BE USER NAME
FIND0: PUSHJ P,SIXIN ;GET ANOTHER
HRL B,PHRASE ;GET THE OTHER PART
FIND0A: MOVEM B,USER
CAIE A,12
JRST FNDERR
MOVE D,MFDPT
AOJGE D,CPOPJ
PUSH P,LPTBUF
SETOM LPTBUF
FIND1: SKIPN A,USER ;LOAD THE MASK
JRST FIND2 ;ZERO MASK: TYPE ANYTHING
MOVE B,0(D) ;MASK ∧ ¬ NAME
TRNN A,-1 ;SKIP IF PROG NAMED
TRZ B,-1 ;NO PROG NAMED. SET PROG TO 0
TLNN A,-1
TLZ B,-1
CAMN A,B
FIND2: PUSHJ P,TYPEX ;TYPE USER NAME
ADD D,[XWD UFDN,UFDN]
JUMPL D,FIND1
CLOSE TTY, ;FLUSH OUTPUT
POP P,LPTBUF ;RESTORE OLD BUFFER POINTER
POPJ P,
FNDERR: OUTSTR [ASCIZ/INVALID ITEM
/]
CLRBFI
POPJ P,
SUBTTL THINK ABOUT PRIVILEGES
PRVTYP: PUSH P,A ;SAVE THE PR BITS
MOVEI A,11 ;WRITE A TAB
PUSHJ P,PUTCHR ;..
HLLZ L,0(P) ;GET THE PR BITS (LEFT)
MOVSI M,-LPBLL ;GET THE LENGTH OF THE TABLE
JUMPE M,PRVTP3 ;JUMP IF NO LEFT SIDE BITS
PRVTP1: TDNN L,LPBITS(M) ;SEE IF A BIT IS SET
JRST PRVTP2 ;NOPE
HRLZ A,LPBITS(M) ;GET THE PRIV NAME
PUSHJ P,SIXOUT ;TYPE SIXBIT
MOVEI A," "
PUSHJ P,PUTCHR ;WRITE A SPACE
PRVTP2: AOBJN M,PRVTP1 ;LOOP
PRVTP3: POP P,L ;GET THE BITS BACK
HRLZ L,L ;GET THE RIGHT SIDE BITS IN THE LEFT
MOVSI M,-RPBLL
JUMPE M,CPOPJ
PRVTP4: TDNN L,RPBITS(M)
JRST PRVTP5
HRLZ A,RPBITS(M)
PUSHJ P,SIXOUT
MOVEI A," "
PUSHJ P,PUTCHR
PRVTP5: AOBJN M,PRVTP4
POPJ P,
PRVGET: MOVEM A,PHRASE+1 ;SAVE OLD PRIV. SET
MOVEM A,PHRASE ;SAVE HERE TOO
JUMPE A,PRVGT0 ;ASK FOR NEW PRIVS
OUTSTR [ASCIZ/ADDED/]
JRST .+2
PRVGT0: OUTSTR [ASCIZ/NEW/]
OUTSTR [ASCIZ/ PRIVILEGES: /]
PRVGT1: PUSHJ P,SIXIN ;GET SOME SIXBIT NAME IN B
MOVEM A,PATCH ;SAVE THE DELIMITER IN MESDAY
MOVSI M,-LPBLL
JUMPE M,PRVGT3 ;NO FLAGS ON THIS SIDE?
JUMPE B,PRVGT7 ;FLUSH NULL STRINGS
PRVGT2: HRRZ A,LPBITS(M) ;GET THE NAME OF A PRIVILEGE
CAME A,B ;COMPARE TO WHAT WE SAW
AOBJN M,PRVGT2
JUMPGE M,PRVGT3
HLLZ A,LPBITS(M) ;GET THE BITS
JRST PRVGT5 ;SET NEW BITS
PRVGT3: MOVSI M,-RPBLL
JUMPE M,PRVGT6 ;THIS IS A LOSS
PRVGT4: HRRZ A,RPBITS(M)
CAME A,B
AOBJN M,PRVGT4
JUMPGE M,PRVGT6
HLRZ A,RPBITS(M) ;GET THE BIT TO SET
PRVGT5: TRNN FL,NEGF
IORM A,PHRASE+1
TRNE FL,NEGF
ANDCAM A,PHRASE+1 ;SHUT OFF BITS
JRST PRVGT7 ;LOOK FOR MORE
PRVGT6: OUTSTR [ASCIZ/UNKNOWN: /]
HRLZ A,B ;GET THE OFFENSIVE NAME
PUSHJ P,SIXOUT ;WRITE IT
OUTSTR CRLF
PRVGT7: MOVE A,PATCH
CAIE A,12 ;LF STOPS THE WORLD
JRST PRVGT1 ;LOOK FOR MORE
MOVE A,PHRASE+1
MOVEM A,INFOS+PRVBIT ;SAVE IN INFOS
POPJ P, ;RETURN
SIXIN: SETZ B, ;ZERO AN AC
TRZA FL,NEGF ;ZERO FLAG FOR -
SIXIN0: TRC FL,NEGF ;SET FLAG
SIXIN1: INCHWL A ;GET A CHARACTER
CAIN A,15
JRST SIXIN1 ;FLUSH CR
CAIE A,40
CAIN A,11
JRST [JUMPE B,SIXIN1 ;IGNORE LEADING BLANKS AND TAB
POPJ P,] ;ELSE RETURN
CAIE A,","
CAIN A,12
POPJ P, ;RETURN FOR LF OR COMMA
CAIN A,"-"
JUMPE B,SIXIN0
CAIL A,"a"
CAILE A,"z"
JRST .+2
TRZ A,40
CAIG A,40
POPJ P, ;RETURN
SUBI A,40
ANDI A,77
TLNE B,770000 ;ANY BITS LEFT IN B?
JRST SIXIN1 ;NOPE FLUSH EXTRA CHARACTERS
LSH B,6
IOR B,A
JRST SIXIN1 ;LOOP
PROTYP: TDNN A,[777400,,000000] ;IF ANY OF THESE ARE ON, TYPE SOMETHING
POPJ P,
MOVEI B,[ASCIZ/ Default protection = /]
PUSH P,A ;SAVE THE WORD
PUSHJ P,PUTSTR
LDB A,[POINT 9,(P),8] ;GET PROTECTION.
PUSHJ P,OCTTYP ;TYPE OCTAL
MOVEI A,11
PUSHJ P,PUTCHR
MOVE A,(P)
TLNN A,400 ;THIS IS INELEGANT, BUT I DON'T REALLY WANT TO
JRST PRORET ;THINK ABOUT IT TOO HARD
MOVEI B,[ASCIZ/
400 Remote Account/]
PUSHJ P,PUTSTR
PRORET: MOVEI B,CRLF
PUSHJ P,PUTSTR
POP P,A
POPJ P,
PROGET: OUTSTR [ASCIZ/New default protection halfword: /]
MOVEI B,0
PROGT1: INCHWL A ;GET A CHARACTER
CAIN A,15
JRST PROGT1 ;FLUSH CR
CAIE A,40
CAIN A,11
JRST [JUMPE B,PROGT1 ;IGNORE LEADING BLANKS AND TAB
POPJ P,] ;ELSE RETURN
CAIL A,"0"
CAILE A,"7"
POPJ P,
LSH B,3
IORI B,-"0"(A)
JRST PROGT1
PTYPE: TTCALL 3,[ASCIZ/The available privileges are:
/]
SETO A,
PUSHJ P,PRVTYP ;TYPE ALL BITS
PRONAM: OUTSTR [ASCIZ/
The fields in the default protection word (LH) are:
777000 default proection for new files
000400 Remote account
/]
POPJ P,
OCTTYP: IDIVI A,10
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,OCTTYP
HLRZ A,(P)
ADDI A,"0"
JRST PUTCHR
SUBTTL LIST USER DATUM.
ILIST: PUSHJ P,LPTINI ;GET THE LPT.
POPJ P, ;NOT THERE
GETPPN A,
PUSHJ P,TYPPN
MOVEI B,[ASCIZ/ requested this listing
/]
PUSHJ P,PUTSTR
ITYPE: MOVE D,MFDPT
AOJGE D,LPTRLS
ILIST1: PUSHJ P,TYPEX ;CALL TYPE OUT ROUTINES
ADD D,[XWD UFDN,UFDN]
JUMPL D,ILIST1
JRST LPTRLS ;RELEASE THE LPT IF IN USE
TYPEX: SKIPE B,0(D) ;IS THERE A PPN HERE?
CAMN B,[' 1 1']
POPJ P, ;NO. RETURN
HLRZ B,1(D) ;MAKE SURE OF VAILD UFD
CAIE B,'UFD'
POPJ P, ;NOT VALID
HRRZ B,3(D) ;GET THE DISK ADDRESS
MOVEM B,INRD1 ;SAVE
PUSHJ P,DOINRD ;READ THE DISK
JRST ILIST5 ;ERROR
MOVE B,[XWD FILE0+INFBAS,INFOS]
BLT B,INFOS+4 ;BLT SPECIAL RETRIEVAL DATA
SKIPN INFOS+LOSPSW ;SKIP IF HE'S GOT PASSWORD
SKIPE LPTBUF ;NO PASSWORD. SKIP IF TTY
JRST ILIST4 ;PASSWORD OR LPT. WRITE IT
SKIPN INFOS+PRVBIT ;SKIP IF HE HAS PRIV BITS
POPJ P, ;TTY AND NO PASSWORD. SKIP THIS
ILIST4: MOVE A,0(D)
PUSHJ P,TYPPN ;WRITE NAME
MOVEI A,11
PUSHJ P,PUTCHR ;AND TAB
SKIPN A,INFOS+LOSPSW ;GET THE PASSWORD
JRST ILST4X ; IF ANY
PUSHJ P,SIXOUT ;WRITE
MOVEI A,"%"
SKIPGE 2(D) ;IF REMOTE-ONLY PASSWORD,
PUSHJ P,PUTCHR ; FLAG IT
ILST4X: SKIPN LPTBUF ;SKIP IF WE'RE ON THE LPT
JRST ILST4A ;ON THE TTY. SHORT MESSAGE
MOVEI A,11
PUSHJ P,PUTCHR ;WRITE A TAB
MOVE A,INFOS+LASDAT ;GET DATE AND TIME
TLZ A,400000 ;DELETE BIT
PUSHJ P,TDOUT ;WRITE TIME AND DATE
MOVEI A,"*"
SKIPGE INFOS+LASDAT
PUSHJ P,PUTCHR ;FLAG ILLEGAL USERS.
ILST4A: SKIPE A,INFOS+PRVBIT ;GET THE USER PRV BITS
PUSHJ P,PRVTYP ;TYPE PR BITS
MOVE A,INFOS+PRVBIT
ANDCM A,ALLPRV
JUMPE A,ILST4B ;JUMP IF NO MYSTERY PRIVS.
PUSH P,A
MOVEI B,[ASCIZ/UNKNOWN PRIVILEGES = /]
PUSHJ P,PUTSTR
POP P,A
PUSHJ P,OCTOUT
ILST4B: MOVEI B,CRLF
PUSHJ P,PUTSTR
MOVE A,INFOS+DEFPRO
JRST PROTYP ;TYPE PROTECTION DATA AND RETURN
ILIST5: MOVEI B,[ASCIZ/DISK ERROR READING UFD
/]
JRST PUTSTR ;WRITE STRING AND POPJ
SUBTTL MODIFY A USER'S INFO ENTRY
MODIFY: OUTSTR [ASCIZ/USER = /]
PUSHJ P,GETP
POPJ P,
SKIPE A,PHRASE+1
SKIPN PHRASE
JRST FNDERR ;MAKE ERROR MESSAGE
HRL A,PHRASE
MOVE D,MFDPT ;GET POINTER TO MFD
AOJL D,MODIF1 ;MAKE DIRECT POINTER
OUTSTR [ASCIZ/MFD IS EMPTY?
/]
POPJ P,
MODIF1: CAMN A,(D) ;LOOK
JRST MODIF3 ;FOUND ONE?
MODIF2: ADD D,[XWD UFDN,UFDN] ;FORGE ON
JUMPL D,MODIF1 ;LOOP
OUTSTR [ASCIZ/NO SUCH UFD.
/]
POPJ P,
MODIF3: HLRZ B,1(D)
CAIE B,'UFD'
JRST MODIF2 ;THIS IS NOT A UFD
CAMN A,[' 1 1']
POPJ P,
PUSH P,D ;SAVE POINTER TO UFD
HRRZ B,3(D) ;GET THE TRACK ADDRESS
MOVEM B,INRD1 ;SAVE
PUSHJ P,DOINRD ;READ RETRIEVAL
JRST ILIST5 ;ERROR
MOVE A,[XWD FILE0+INFBAS,INFOS]
BLT A,INFOS+INFON-1 ;GET THE DATA TO A CONVENIENT PLACE
PUSHJ P,MTYPE ;TYPE DATA FOR THIS GUY.
OUTSTR [ASCIZ/NEW PASSWORD = /]
PUSHJ P,GETP ;GET A PASSWORD
SETZM PHRASE ;NULL PASSWORD
MOVE A,PHRASE ;GET IT
MOVEM A,INFOS+LOSPSW ;SAVE IT
MOVE A,INFOS+PRVBIT ;GET PRIVILEGES
PUSHJ P,PRVGET ;GET A NEW SET OF PRIVILEGES
PUSHJ P,PROGET ;GET NEW PROTECTION BITS
MOVSM B,INFOS+DEFPRO ;SAVE NEW PROTECTION BITS IN LH
MOVE D,(P)
OUTSTR [ASCIZ/
DATA FOR THIS USER IS NOW:
/]
PUSHJ P,MTYPE
POP P,D ;GET D BACK AGAIN
OUTSTR [ASCIZ/WRITE THIS NOW? /]
PUSHJ P,YORN
POPJ P, ;NO
MOVE K,(D) ;GET USER NAME
MOVSI L,'UFD'
SETZ M,
MOVE N,GOD
LOOKUP DMP,K
JRST MODIF4 ;CAN'T ENTER
; SETZM INFOS+LASDAT+1
; MOVE K,[XWD INFOS+LASDAT+1,INFOS+LASDAT+2]
; BLT K,INFOS+INFON-1
MTAPE DMP,WRINFO ;WRITE DATA INTO FILE
JRST MODIF5 ;ERROR
CLOSE DMP, ;RELEASE FILE
POPJ P,
MODIF4: OUTSTR [ASCIZ/
UFD LOOKUP FAILED
/]
POPJ P,
MODIF5: CLOSE DMP,
OUTSTR [ASCIZ/INFO WRITE FAILED
/]
POPJ P,
MTYPE: MOVE A,(D) ;GET THE PPN
PUSHJ P,TYPPN
MOVEI A,11
PUSHJ P,PUTCHR
SKIPN A,INFOS+LOSPSW
JRST MTYPE1
PUSHJ P,SIXOUT
MOVEI A,"%"
SKIPGE 2(D)
PUSHJ P,PUTCHR
MTYPE1: SKIPE A,INFOS+PRVBIT
PUSHJ P,PRVTYP
MOVEI B,CRLF
JRST PUTSTR
MOVE A,INFOS+DEFPRO
PUSHJ P,PROTYP ;TYPE PROTECTION PART
MOVEI B,CRLF
JRST PUTSTR
DOINRD: MTAPE DMP,INRD ;READ RETRIEVAL
POPJ P, ;ERROR
AOS (P)
MOVEM A,1(P)
HRRZ A,(D) ;GET USER NAME
; CAIE A,'REG' ;SPECIAL?
JRST DOINR0 ;YES.
DOINR1: SKIPE A,FILE0+LOSPSW+INFBAS
MOVE A,['QRALPH']
MOVEM A,FILE0+LOSPSW+INFBAS
DOINR0: MOVE A,1(P) ;GET DATA BACK
POPJ P,
SUBTTL READ UFD
RMFD: MOVE A,GOD
MOVSI B,'UFD'
SETZ C,
MOVE D,GOD
MOVEI W,UFDN
ADDM W,JOBFF ;INCREMENT JOBFF TO LEAVE SOME ROOM
PUSHJ P,DREAD
EXIT ;THIS BETTER NOT HAPPEN. EVER
SUB W,[XWD UFDN,UFDN]
MOVEM W,MFDPT ;SAVE POINTER TO MFD
MOVE A,GOD
MOVSI B,'UFD'
SETZ C,
MOVEI D,MFDTRK ;1 IS THE TRACK ADDRESS OF MFD
MOVEI X,1(W)
HRLI X,A ;SOURCE,,DESTINATION IN X
BLT X,4(W) ;SAVE THE STUFF
POPJ P, ;RETURN
SUBTTL DREAD READ A WHOLE FILE IN DUMP MODE.
; SET A,B,C,D TO A LOOKUP BLOCK.
; SKIP RETURN IF OK. W IS IOWD FOR DATA. FILE READ INTO JOBFF
; NON SKIP: MESSAGE WILL BE TYPED
DREAD: SETZB W,X ;ZERO THINGS TO START RIGHT
LOOKUP DMP,A ;LOOK FOR THE FILE
JRST DREAD1 ;FILE NOT FOUND. CODE IN B
HRR D,JOBFF ;GET JOBFF
SUBI D,1 ;MAKE THIS AN IOWD
MOVE W,D ;SAVE THE IOWD
HLRE C,D ;GET - LENGTH OF FILE
MOVN B,C ;GET + FILE LENGTH
ADDB B,JOBFF ;RESET JOBFF
CAMG B,JOBREL ;IS IT TOO BIG?
JRST .+3 ;NO. WE'RE OK
CORE B, ;MAKE ENOUGH CORE HAPPEN
JRST NOCORE ;THIS IS A LOSS
INPUT DMP,W ;USE THE IOWD IN W TO READ THE WHOLE
STATZ DMP,740000 ;CHECK TRANSFER STATUS
JRST DREAD2 ;LOSING STATUS
CLOSE DMP, ;RELEASE THE FILE
JRST CPOPJ1 ;GIVE THE OK RETURN
DREAD1: CAME A,['ALFACT'] ;NO MESSAGE IF ACCOUNTING LOSES.
TRNE FL,PTYLIN
JRST DREAD4
OUTSTR [ASCIZ/LOOKUP FAILURE. FILE = /]
PUSH P,A
PUSH P,B ;SAVE FILE AND CODE
PUSHJ P,TYFIL ;WRITE FILE NAME
OUTSTR [ASCIZ/; CODE = /]
HRRZ A,(P) ;GET FROM STACK
JRST DREAD3
DREAD2: TRNE FL,PTYLIN
JRST DREAD4
OUTSTR [ASCIZ/I-O ERROR. FILE = /]
PUSH P,A
PUSH P,B
PUSHJ P,TYFIL
OUTSTR [ASCIZ/; STATUS = /]
GETSTS DMP,A
DREAD3: PUSHJ P,OCTOUT
OUTSTR CRLF
POP P,B
POP P,A
DREAD4: CLOSE DMP,
POPJ P,
SUBTTL INITIALIZE
BEGIN: RESET ;A GOOD WAY TO START THE DAY
MOVE P,[IOWD PDLEN,PDLIST] ;INITIALIZE PDL
SETOM CKCODE ;ASSUME LEGITIMATE USER.
INIT DMP,217 ;GET A DISK CHANNEL FOR USE LATER
'DSK '
0
JRST NODISK ;THIS IS TERRIBLE
PUSHJ P,TTYINI ;GET A TTY
DATE A, ;GET CURRENT DATE
TIMER B, ;AND TIME IN TICKS SINCE MIDNITE
IDIVI B,74*74 ;DIVIDE TICKS TO MAKE MINUTES
HRL B,A ;MAKE DATE,,TIME
MOVEM B,NOW ;SAVE TIME
SETO A, ;SET A TO GET LINE CHARACTERISTICS
TTCALL 6,A ;GET LINE CHARACTERISTICS
MOVEM A,LINCHR ;LINE CHARACTERISTICS WORD
TLNE A,DPYBIT+DDBIT ;EITHER DATA DISK OR III?
TRO FL,DPYLIN ;YES FLAG IT
TLNE A,CTYBIT ;CTY?
TRO FL,CTYLIN ;YES
TLNE A,PTYBIT
TROA FL,PTYLIN ;FLAG A PTY
JRST BEGNPT ;THIS IS NOT A PTY.
TLNE A,IMPBIT ;IS THIS AN IMP?
TRC FL,IMPLIN+PTYLIN ;YES. SET IMP AND NOT PTY.
MOVEI A,TTYNUM ;PEEK INTO SYSTEM
PEEK A,
LDB B,[POINT 9,A,8] ;
LDB C,[POINT 9,A,17];
ADDI B,1(C)
LDB C,[POINT 9,A,26]
ADDI B,(C)
HRRZ A,LINCHR
SUBI A,(B)
SETZM PTYPPN ;CLEAR PPN OF OWNER
SETZM PTYTJB
JUMPL A,BEGNPT ;THIS CAN'T HAPPEN?
MOVEI B,PTYJOB
PEEK B,
ADDI B,(A)
PEEK B,
MOVEM B,PTYTJB ;JOB NUMBER OF CONTROLLING JOB.
TLNE FL,IMPLIN ;IS THIS AN IMP ALREADY?
JRST BEGNPT ;YES. (PTYTJB IS SETUP)
GETPRV B, ;USER'S PRIVILEGES
TLNN B,1 ;LOCAL USER?
TRC FL,IMPLIN!PTYLIN ;NO TURN ON IMPLIN
MOVEI A,PRJPRG
PEEK A,
ADD A,PTYTJB
PEEK A,
MOVEM A,PTYPPN ;PPN OF PTY OWNER.
BEGNPT: JRST USRMOD ;NO. RUN THE USER MODE PORTION
SUBTTL DO-ALL SCANNER. MAXIMUM UTILITY AND INTOLERANCE.
GETP: SETZB B,PHRASE ;B = SIXBIT ACC. PHRASE 1
SETZB C,PHRASE+1 ;C WILL COUNT PHRASES,, PHRASE 2
MOVEI D,40 ;WE WILL WAIT 32 SECONDS FOR TYPIN
INCHWL A ;SPECIAL. WE'LL WAIT FOREVER
JRST GETCK ;OK. WE SAW ONE.
GETCH: INCHRS A ;GET ANOTHER, OR SKIP
POPJ P, ;NOTHING THERE. WE MAKE AN ERROR
GETCK: JUMPE A,GETCH ;FLUSH NULLS. NO ONE CAN SEND THEM.
JFCL ;PATCH HERE.
CAIN A,12 ;LF ENDS EVERYTHING
JRST GETHF ;ALL DONE
CAIN A,15
JRST GETCH ;FLUSH CR
CAIE A,40
CAIN A,11
JRST [ ; JUMPE C,GETCH ;FLUSH BLANKS AND TABS IN FIRST TERM
JUMPE B,GETCH ;FLUSH LEADING BLANKS AND TABS
JRST GETHF] ;ASSUME THAT WE'VE SEEN WHOLE TERM
CAIN A,175 ;IS THIS AN ALTMODE?
EXIT ;YES. ABORT LOGIN
CAIN A,"⊗" ;SPECIAL?
JRST SETDDT ;YES GO SET THE DEBUG MODE
CAIE A,"," ;COMMA DELIMITS PHRASE 1.
CAIN A,"/" ;SO DOES SLASH
JRST GETHF0 ;GO ANNOUNCE THE DELIMITER.
CAIE A,"." ;ALLOW THIS AS QUICKIE ALSO -- RPH
CAIN A,"|"
JRST GETHFA
CAIN A,"%" ;SO DOES %
JRST GETHF0 ;DO THE DELIMITER THING
CAIL A,"0"
CAILE A,"9"
JRST .+2
JRST GETCON ;ALLOW DIGITS THROUGH
CAIL A,"a"
CAILE A,"z"
JRST .+2 ;NOT LOWER CASE
TRZ A,40 ;MAKE UPPER CASE
CAIL A,"A"
CAILE A,"Z"
JRST [SETOM PHRASE ;THIS IS A LOSER
POPJ P,]
GETCON: SUBI A,40 ;MAKE SIXBIT
ANDI A,77 ;SCRAPE OFF ANY EXCESS BITS.
TLNE B,770000 ;DON'T SHIFT TOO FAR
JRST GETCH ;TOO FAR. IGNORE ANYTHING ELSE
LSH B,6 ;MAKE ROOM.
IOR B,A
JRST GETCH ;GO GET SOME MORE.
GETHFA: TRO FL,NODATE ;TURN ON FLAG
GETHF0: MOVE K,A ;SAVE THE DELIMITER HERE.
GETHF: JUMPE B,CPOPJ ;NO JUSTIFICATION FOR NOTHING.
MOVEM B,PHRASE(C)
CAIN A,12
JRST CPOPJ1
SETZB B,D
JUMPG C,SSCAN ;SCAN FOR SERVICE LEVEL
AOJA C,GETCH ;INCREMENT TERM COUNTER
SSCAN: INCHRS A ;GET A CHARACTER
POPJ P, ;NO GOOD
CAIN A,12 ;LINE FEED?
JRST SSCANX ;YES THATS ALL
CAIN A,15 ;FLUSH CR
JRST SSCAN
CAIE A,40
CAIN A,11
JRST SSCAN ;FLUSH BLANK,TAB
CAIL A,"0" ;SKIP IF TOO SMALL
CAILE A,"9"
POPJ P, ; THIS IS A LOSS
IMULI D,12 ;ACCUMULATE IN D
ADDI D,-"0"(A) ;ADD IN DIGIT
JRST SSCAN
SSCANX: JRST CPOPJ1 ;DO THE SKIP RETURN
YORN: MOVEI B,74 ;60 SECONDS OF WAITING
CLRBFI ;FLUSH THE WORLD FIRST
YORN0: MOVEI A,1 ;SLEEP 1 SECOND
SLEEP A, ;SLEEP 1 SECOND
INCHRS A ;LOOK FOR A CHARACTER
JRST YORN0 ;NOT THERE, WAIT
CLRBFI
OUTSTR CRLF
CAIE A,"Y"
CAIN A,"y"
JRST CPOPJ1 ;SKIP RETURN FOR "Y"
CAIE A,175 ;LOOK FOR ALTMODE
POPJ P, ;IS OK
EXIT ;KILL THE BASTARD
SETDDT: SKIPN JOBDDT ;SKIP IF WE HAVE DDT
POPJ P, ;ILLEGAL CHARACTER IN SCAN
OUTSTR [ASCIZ/(DDT)
/] ;TELL HIM WHERE ITS AT.
JRST @JOBDDT ;JUMP TO DDT
CPOPJ1: AOS (P)
CPOPJ: POPJ P, ;RETURN
END BEGIN